home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / msgShow.tcl.z / msgShow.tcl
Text File  |  2002-07-08  |  18KB  |  604 lines
  1. # msgShow.tcl
  2. #
  3. # Message display.
  4. #
  5. # Copyright (c) 1993 Xerox Corporation.
  6. # Use and copying of this software and preparation of derivative works based
  7. # upon this software are permitted. Any distribution of this software or
  8. # derivative works must comply with all applicable United States export
  9. # control laws. This software is made available AS IS, and Xerox Corporation
  10. # makes no warranty about the software, its performance or its conformity to
  11. # any specification.
  12.  
  13. set msg(maxsize) 50000
  14.  
  15. # This procedure allocates text tags used in message display.
  16. # This is done once to avoid the cost of doing it on every message.
  17. # Tag creation order is important - later tags have higher priority and
  18. # appear "on top" of tags created earlier.
  19.  
  20. proc Msg_Setup { t } {
  21.     global fdisp exmh
  22.     foreach level {error warn normal background} {
  23.     $t tag configure hdrlook=exmhColor$level -background $exmh(c_st_$level)
  24.     }
  25.     $t tag configure hdrlook=exmhColorPopup -background $fdisp(c_popup)
  26.     # Tags for header looks
  27.     global msg
  28.     foreach tagname $msg(tagnames) {
  29.     # Set up looks for different header lines
  30.     set rval [option get . m_$tagname {}]
  31.     if {$rval != {}} {
  32.         set msg(tag,$tagname) $rval
  33.         if [catch {
  34.         eval {$t tag configure hdrlook=$tagname} $rval
  35.         } err] {
  36.         unset msg(tag,$tagname)
  37.         }
  38.     }
  39.     }
  40.     # More tags to pre-allocate darker mime backgrounds.
  41.     if {[winfo depth .] > 4} {
  42.     set color default
  43.     foreach level {1 2 3 4 5 6} {
  44.         set color [MimeDarkerColor $t $color]
  45.         $t tag configure hdrlook=exmhColor$level -background $color
  46.     }
  47.     }
  48.  
  49.     # Create the part tags first so the highlight tags are higher priority
  50.  
  51.     set part 0
  52.     set defaultTag [MimeLabel $part=1 part]
  53.     $t tag configure $defaultTag -background [$t cget -background] \
  54.     -foreground [$t cget -foreground]
  55.  
  56.     # Allocate active button colors, too
  57.     TextButton_Init $t
  58.  
  59.     # Tags for text highlighting
  60.     Msg_HighlightInit $t
  61.         
  62.     $t tag raise sel
  63.  
  64.     # HACK To cache font for graphics part separator.
  65.     catch {
  66.     label $t.fontlabel6 -font -*-*-*-*-*-*-6-*-*-*-*-*-iso8859-*
  67.     label $t.fontlabel8 -font -*-*-*-*-*-*-8-*-*-*-*-*-iso8859-*
  68.     }
  69.  
  70. }
  71.  
  72. proc Msg_HighlightInit { t } {
  73.     foreach tagname {attrib_me quote_me attrib1 attrib2 attrib3 attrib4 \
  74.              attrib5 quote1 quote2 quote3 quote4 quote5 signature \
  75.              listsig msheader1 msheader2 udiffold udiffnew \
  76.              bugrpttok} {
  77.         set rval [option get . b_$tagname {}]
  78.         eval {$t tag configure $tagname} $rval
  79.     }
  80. }
  81.  
  82. proc Msg_Redisplay { draft } {
  83.     global msg mhProfile exmh msg
  84.     if {[string compare $draft $msg(path)] == 0} {
  85.     set msg(dpy) {}
  86.     MsgShow $msg(id)
  87.     }
  88. }
  89.  
  90.  
  91. proc MsgShow { msgid } {
  92.     # Display the current message in a text widget
  93.     global msg exwin exmh mhProfile mimeHdr mime
  94.  
  95.     if {$msg(dpy) == $msgid} {
  96.     return
  97.     }
  98.     Html_Stop $exwin(mtext)
  99.     Label_Message $exmh(folder):$msgid
  100.     Audit "Show $exmh(folder) $msgid"
  101.     if [MsgShowInText $exwin(mtext) $mhProfile(path)/$exmh(folder)/$msgid] {
  102.     MsgSeen $msgid
  103.     if {!$mime(stop)} {
  104.         set msg(dpy) $msgid
  105.     }
  106.     set msg(curclear) 0
  107.     set mime(stop) 0
  108.     update idletasks    ;# Faces display can be slow
  109.  
  110.     Face_Show [MsgParseFrom $mimeHdr(0=1,hdr,from)] $mimeHdr(0=1,hdr,x-face) $mimeHdr(0=1,hdr,x-image-url) $mimeHdr(0=1,hdr,newsgroups)
  111.  
  112.     foreach cmd [info commands Hook_MsgShow*] {
  113.         $cmd $mhProfile(path)/$exmh(folder)/$msgid mimeHdr
  114.     }
  115.     Find_Reset
  116.     }
  117. }
  118. proc MsgShowInText { win file } {
  119.     global mhProfile msg mimeHdr exmh msg mhProfile mime
  120.     $win configure -state normal
  121.     $win delete 0.0 end
  122.     $win mark set insert 1.0
  123.  
  124.     if [info exists mhProfile(exmhshowproc)] {
  125.     Exmh_Debug MsgShowInText $mhProfile(exmhshowproc) $file
  126.     set fileName [concat "|" $mhProfile(exmhshowproc) $file]
  127.     } else {
  128.     set fileName $file
  129.     }
  130.     Mime_Cleanup $win    ;# tmp files from last message.
  131.     set part 0
  132.     set subpart 1
  133.  
  134.     set mimeHdr($part=$subpart,hdr,cur) {}
  135.     set mimeHdr($part=$subpart,hdr,from) {}
  136.     set mimeHdr($part=$subpart,hdr,date) {}
  137.     set mimeHdr($part=$subpart,hdr,subject) {}
  138.     set mimeHdr($part=$subpart,hdr,x-face) {}
  139.     set mimeHdr($part=$subpart,hdr,x-image-url) {}
  140.     set mimeHdr($part=$subpart,hdr,newsgroups) {}
  141.     set mimeHdr($part=$subpart,fullHeaders) $mime(fullHeaders)
  142.     set mimeHdr($part=$subpart,yview) 1.0
  143.  
  144.     set mimeHdr($part,decode) 1
  145.     set mimeHdr($part,file) $fileName
  146.     set mimeHdr($part,rawfile) $file
  147.     set mimeHdr($part,color) [lindex [$win configure -background] 4]
  148.     set mimeHdr($part,type) message/rfc822
  149.     set mimeHdr($part,encoding) 7bit
  150.     set mimeHdr($part,hdr,content-type) message/rfc822
  151.     set mimeHdr($part,HeaderSize) 0
  152.     set mimeHdr($part,display) 1
  153.  
  154.     global mimeFont mime
  155.     if ![info exists mimeFont(default)] {
  156.     set mimeFont(title) [Mime_GetFont $win bold r title $mime(titleSize) us-ascii]
  157.     set mimeFont(note) [Mime_GetFont $win medium i title $mime(noteSize) us-ascii]
  158.     set mimeFont(default) [Mime_GetFont $win medium r plain $mime(fontSize) us-ascii]
  159.  
  160.     }
  161.  
  162.     set partTag [MimeLabel $part part]
  163.     set defaultTag [MimeLabel $part=1 part]
  164.     $win tag configure $defaultTag -background [$win cget -background] \
  165.     -foreground [$win cget -foreground]
  166.     MimeSetPartVars desc displayedPart $win $part $partTag
  167.     if {$mimeHdr($part,numParts) > 0} {
  168.     $win config -cursor watch
  169.     MimeSetStdMenuItems $win $part
  170.     Mime_ShowRfc822 $win $part
  171.     }
  172.     $win config -cursor [option get $win cursor Text ]
  173.     MimeInsertSeparator $win $part 6
  174.     Widget_TextPad $win $mimeHdr(0=1,yview)
  175.     $win yview $mimeHdr(0=1,yview)
  176.  
  177.     catch {unset mimeLastPoint}
  178.     catch {unset mimeTagStack}
  179.  
  180.     Exmh_Status "$desc"
  181.  
  182.     $win configure -state disabled
  183.     return 1
  184. }
  185.  
  186. proc MsgParseFrom { fromline {setaddr setaddr} } {
  187.     set line [string trim $fromline]
  188.     if [regsub {\(.*\)} $line {} newline] {
  189.     set line $newline
  190.     }
  191.     if [regexp {<.*@.*>} $line token] {
  192.     set token [string trim $token <>]
  193.     } elseif [regexp {[^     "]*@[^     "]*} $line token] {
  194.     set token [string trim $token <>]
  195.     } else {
  196.     if [regexp {<.*>} $line token] {
  197.         set token [string trim $token <>]
  198.     } else {
  199.         if [catch {lindex $line 0} token] {
  200.         set token {}
  201.         Exmh_Debug MsgParseFrom failed on: $fromline
  202.         }
  203.     }
  204.     }
  205.     if {[string compare $setaddr "setaddr"] == 0} {
  206.     # Link to alias interface
  207.     global address
  208.     set address $token
  209.     }
  210.     return $token
  211. }
  212.  
  213. proc Hook_MsgShowListHeaders {msgPath headervar} {
  214.     upvar $headervar header
  215.  
  216.     global exwin
  217.     
  218.     # From rfc2369:
  219.   
  220.     # The contents of the list header fields mostly consist of angle-
  221.     # bracket ('<', '>') enclosed URLs, with internal whitespace being
  222.     # ignored. MTAs MUST NOT insert whitespace within the brackets, but
  223.     # client applications should treat any whitespace, that might be
  224.     # inserted by poorly behaved MTAs, as characters to ignore.
  225.     #
  226.     # A list of multiple, alternate, URLs MAY be specified by a comma-
  227.     # separated list of angle-bracket enclosed URLs. The URLs have order of
  228.     # preference from left to right. The client application should use the
  229.     # left most protocol that it supports, or knows how to access by a
  230.     # separate application. 
  231.     #
  232.     # [...]
  233.     #
  234.     # To allow for future extension, client applications MUST follow the
  235.     # following guidelines for handling the contents of the header fields
  236.     # described in this document:
  237.     #
  238.     # 1) Except where noted for specific fields, if the content of the
  239.     #    field (following any leading whitespace, including comments)
  240.     #    begins with any character other than the opening angle bracket
  241.     #    '<', the field SHOULD be ignored.
  242.     #
  243.     # 2) Any characters following an angle bracket enclosed URL SHOULD be
  244.     #    ignored, unless a comma is the first non-whitespace/comment
  245.     #    character after the closing angle bracket.
  246.     #
  247.     # 3) If a sub-item (comma-separated item) within the field is not an
  248.     #    angle-bracket enclosed URL, the remainder of the field (the
  249.     #    current, and all subsequent, sub-items) SHOULD be ignored.
  250.  
  251.     # Loop through the list- headers
  252.     set menuitems {}
  253.     foreach index [array names header 0=1,hdr,list-*] {
  254.     # Get the suffix portion of the header name
  255.     regsub {^.*,list-} $index {} name
  256.     # Remove comments
  257.     regsub -all {\([^()]*\)} $header($index) {} h
  258.     # Remove whitespace
  259.     regsub -all " " $h {} h
  260.     # Loop through the fields
  261.     foreach f [split $h ,] {
  262.         # Stricture #1
  263.         if {[string index $f 0] == "<"} {
  264.         # Stricture #2
  265.         regexp "<(.*)>" $f match url
  266.         lappend menuitems $name $url
  267.         } else {
  268.         # Stricture #3
  269.         break
  270.         }
  271.     }
  272.     }
  273.     if {$menuitems != {}} {
  274.     if [winfo exists $exwin(mopButtons).list] {
  275.         set menu $exwin(mopButtons).list.m
  276.     } else {
  277.         set menu [Widget_AddMenuB $exwin(mopButtons) list "List..." {right padx 1 filly}]
  278.     }
  279.     $exwin(mopButtons).list.m delete 1 99
  280.     foreach {name url} $menuitems {
  281.         Widget_AddMenuItem $menu $name [list URI_StartViewer $url]
  282.     }
  283.     } else {
  284.     catch {destroy $exwin(mopButtons).list}
  285.     }
  286. }
  287.  
  288. # Highlight text/plain regions of the message
  289.  
  290. proc Msg_TextHighlight {tkw start end} {
  291.     Exmh_Debug Msg_TextHighlight $start $end
  292.     foreach cmd [info commands Hook_MsgHighlight*] {
  293.     $cmd $tkw $start $end
  294.     }
  295. }
  296.  
  297. # The original version of this file can always be found here:
  298. #
  299. #   ftp://ftp.kanga.nu/pub/users/claw/dot/tk/exmh/quote-colour.tcl
  300. #
  301. #
  302. # Please send patches and bug reports to claw@kanga.nu and/or the
  303. # exmh-users list at exmh-users@redhat.com
  304. #
  305. # A working set of surrounding configuration files can be found here:
  306. # 
  307. #   ftp://ftp.kanga.nu/pub/users/claw/dot/tk/
  308. #   ftp://ftp.kanga.nu/pub/users/claw/dot/exmh
  309. #
  310. # Screenshots of the quote colourising code in action can be found
  311. # here:
  312. #
  313. #   ftp://ftp.kanga.nu/pub/users/claw/screenshots/exmh/JCL.exmh.9.png
  314. #   ftp://ftp.kanga.nu/pub/users/claw/screenshots/exmh/JCL.exmh.10.png
  315. #   ftp://ftp.kanga.nu/pub/users/claw/screenshots/exmh/JCL.exmh.11.png
  316.  
  317. # Enable this with the "Highlight Message Quotes" under Mime preferences
  318.  
  319. # Contributors to the quote colouring code:
  320. #
  321. #   Anthony DeStefano <destefan@vaxcave.com>
  322. #   J C Lawrence <claw@kanga.nu>
  323. #   John Beck <jbeck@eng.sun.com>
  324. #   John Klassa <klassa@ipass.net>
  325. #   Joseph V Moss <jmoss@ichips.intel.com>
  326. #   Iain MacDonnell <Iain.MacDonnell@Sun.COM>
  327. #    
  328. # Changelog:
  329. #   Tue, 05 Jun 2001 23:25:38 -0700
  330. #     Initial request to exmh-users list for quote colouring code
  331. #     by J C Lawrence 
  332. #   Thu, 21 Jun 2001 10:08:11 -0400
  333. #     John Klasse posted his quote colouring code
  334. #   Thu, 21 Jun 2001 23:58:17 -0700
  335. #     J C Lawrence extended with support for multi-level quotes, MS
  336. #     Outlook quoe headers, forwarded message headers, Mailman
  337. #     footers, .signatures, etc
  338. #   Mon, 25 Jun 2001 16:58:03 -0700 
  339. #     John Beck did various clean ups, polishing etc
  340. #   Mon, 25 Jun 2001 17:52:15 -0700 
  341. #     Iain MacDonnell cleaned up and rewrote the cite handling, and 
  342. #     added the seperate quote function and exported the configs to
  343. #     exmh-defaults-colour
  344. #
  345. #     Iain MacDonnell re-worked the quote recognition part to
  346. #     recognise various "quote things", such as ">", ":", "}", "+>" 
  347. #     and "Iain>"
  348. #
  349. #     Joseph V Moss fixed above to work with older versions of tcl 
  350. #     that don't support "fancy" regexps
  351. #
  352. #     John Beck added support for colour definitions as config options
  353. #     rather than being hard-coded.
  354. #   Tue, 26 Jun 2001 19:32:22 -0400 
  355. #     Anthony DeStefano added documentation
  356. #  
  357.  
  358. # To configure/customuise, add the following resources to
  359. # ~/.exmh/exmh-defaults-colour, edited as per your colour
  360. # preferences.  The following colours are intended for a black
  361. # background.
  362. #
  363. # --<cut>--
  364. #
  365. # ! Colours to use for quotes of your text if emabled below.
  366. # *b_attrib_me: -foreground magenta
  367. # *b_quote_me:  -foreground purple
  368. #
  369. # ! Colours for the quote prefixes for different levels of quote
  370. # *b_attrib1:   -foreground palegreen
  371. # *b_attrib2:   -foreground lawngreen
  372. # *b_attrib3:   -foreground limegreen
  373. # *b_attrib4:   -foreground seagreen3
  374. # *b_attrib5:   -foreground seagreen4
  375. #
  376. # ! Colours for the quoted text for different levesl of quote
  377. # *b_quote1:    -foreground khaki
  378. # *b_quote2:    -foreground tan
  379. # *b_quote3:    -foreground darksalmon
  380. # *b_quote4:    -foreground goldenrod
  381. # *b_quote5:    -foreground gold
  382. # 
  383. # ! Colour of .signature blocks
  384. # *b_signature: -foreground gold
  385. # 
  386. # ! Colour of Mailman list footers.
  387. # *b_listsig:   -foreground cornflowerblue
  388. #
  389. # ! Colour of MS Outlook quoted header field names
  390. # *b_msheader1: -foreground lightslateblue
  391. #
  392. # ! Colour of MS Outlook quoted header filed contents
  393. # *b_msheader2: -foreground seagreen2
  394. #
  395. # ! Unified diff colours
  396. # *b_udiffold:  -foreground red
  397. # *b_udiffnew:  -foreground blue
  398. #
  399. # ! Sun bug report colours
  400. # *b_bugrpttok: -foreground yellow
  401.  
  402. # This hook is called on a range of text that is a message body.
  403.  
  404. proc Hook_MsgHighlight_jcl-beautify {t {start 1.0} {end end}} {
  405.     global mime
  406.  
  407.     if {!$mime(highlightText)} {
  408.     return
  409.     }
  410.     $t tag remove attrib $start $end
  411.     $t tag remove quote  $start $end
  412. #    $t tag remove body   $start $end
  413.  
  414.  
  415.     set in_signature 0
  416.     set in_msheader 0
  417.     set in_listsig 0
  418.     set in_udiff 0
  419.  
  420.     set endx [$t index end]
  421.     for {set idx [expr int($start)]} {$idx <= $endx} {incr idx} {
  422.     set txt [$t get $idx.0 $idx.end]
  423.     
  424.     if {$txt == ""} {
  425.         set in_listsig 0
  426.         set in_msheader 0
  427.         set in_signature 0
  428.         set in_udiff 0
  429.     } 
  430.  
  431.     if {[regexp {^---------+$} $txt] || [regexp {^______+$} $txt]} {
  432.         set in_listsig 1
  433.         set in_msheader 0
  434.         set in_signature 0
  435.         set in_udiff 0
  436.     } 
  437.  
  438.     if {[regexp {^--* *Original Message *--*$} $txt] 
  439.         || [regexp {^[-]+ *Forwarded Message *$} $txt]
  440.         || [regexp {^[-]+ *End of Forwarded Message *$} $txt]} {
  441.         set in_listsig 0
  442.         set in_msheader 1
  443.         set in_signature 0
  444.         set in_udiff 0
  445.     }
  446.  
  447.     if {[regexp {^-- ?$} $txt]} {
  448.         set in_listsig 0
  449.         set in_msheader 0
  450.         set in_signature 1
  451.         set in_udiff 0
  452.     } 
  453.  
  454.     if {[regexp {^@@.*@@$} $txt]} {
  455.         set in_listsig 0
  456.         set in_msheader 0
  457.         set in_signature 0
  458.         set in_udiff 1
  459.     } 
  460.  
  461.     if {$in_udiff == 1} {
  462.         if {[regexp {^-} $txt d line]} {
  463.         $t tag add udiffold $idx.0 $idx.end
  464.         } elseif {[regexp {^\+} $txt d line]} {
  465.         $t tag add udiffnew $idx.0 $idx.end
  466.         } else {
  467. #        $t tag add body $idx.0 $idx.end
  468.         }
  469.         continue
  470.     }
  471.  
  472.     if {$in_msheader == 1 } {
  473.             if {[regexp {^([^:]*:)} $txt d header]} {
  474.         $t tag add msheader1 $idx.0 $idx.[expr [string length $header] - 1]
  475.         $t tag add msheader2 $idx.[expr [string length $header] - 1] $idx.end
  476.         } else {
  477.         $t tag add msheader2 $idx.0 $idx.end
  478.         }
  479.         continue
  480.     } 
  481.  
  482. # Enable this block if you can recognise quotes of your (written by
  483. # you) text.  This will then attempt to coloruise that text using
  484. # the attrib_me and quote_me colour pair.
  485.  
  486. # Note: You'll have to edit the regexp lines to fit/match your
  487. # quotes.
  488.  
  489. #    if {[regexp {^(\+>)} $txt d quote] 
  490. #        || [regexp {^(John>)} $txt d quote] 
  491. #        || [regexp {^(JBeck>)} $txt d quote]} {
  492. #        $t tag add attrib_me $idx.0 $idx.[expr [string length $quote] - 1]
  493. #        $t tag add quote_me  $idx.[expr [string length $quote] - 1] $idx.end
  494. #        continue
  495. #        }
  496.  
  497.     lassign {qt_cnt qt_str} [MsgHighlightQuoteLevel $txt]
  498.     if {$qt_cnt >= 5} {
  499.         set qt_cnt 5
  500.     }
  501.  
  502.         if {$qt_cnt > 0} {
  503.             $t tag add attrib$qt_cnt $idx.0 $idx.[string length $qt_str]
  504.             $t tag add quote$qt_cnt $idx.[string length $qt_str] $idx.end
  505.         }
  506.  
  507.     if {$in_listsig == 1} {
  508.         $t tag add listsig $idx.0 $idx.end
  509.         continue
  510.     }
  511.     
  512.     if {$in_signature == 1} {
  513.         $t tag add signature $idx.0 $idx.end
  514.         continue
  515.     }
  516.  
  517. #    $t tag add body $idx.0 $idx.end
  518.     }
  519. }
  520.  
  521. # The bug reporting highlighting is done on the whole message
  522. # because it must scan headers
  523.  
  524. proc Hook_MsgShow_BugReport {msg mimeHdr} {
  525.    global exwin mime
  526.     if {!$mime(highlightText)} {
  527.     return
  528.     }
  529.    $exwin(mtext) configure -state normal
  530.    MsgShow_BeautifyBugrpt $exwin(mtext)
  531.    $exwin(mtext) configure -state disabled
  532. }
  533. proc MsgShow_BeautifyBugrpt {t {start 1.0} {end end}} {
  534.  
  535.     set in_bugrpt 0
  536.     set in_header 1
  537.  
  538.     set endx [$t index end]
  539.     for {set idx [expr int($start)]} {$idx <= $endx} {incr idx} {
  540.     set txt [$t get $idx.0 $idx.end]
  541.     
  542.     if {$txt == "" && $in_header} {
  543.         # End of headers
  544.         set in_header 0
  545.         if {$in_bugrpt == 0} {
  546.         return
  547.         }
  548.     } 
  549.  
  550.     if {[regexp {^Subject: BugId [0-9].* Has been Updated .*$} $txt] ||\
  551.         [regexp {^Subject: BugId [0-9].* Priority value ch.*$} $txt] ||\
  552.         [regexp {^Subject: BugId [0-9].* New .* Created, .*$}  $txt] ||\
  553.         [regexp {^Subject: BugId [0-9].* Responsible .*er$}    $txt]} {
  554.         set in_bugrpt 1
  555.     }
  556.     if {$in_bugrpt == 1} {
  557.         if {[regexp {^ Synopsis:} $txt d line]} {
  558.         $t tag add bugrpttok $idx.1 $idx.end
  559.         } elseif {[regexp {^ Description:} $txt d line]} {
  560.         $t tag add bugrpttok $idx.1 $idx.end
  561.         } elseif {[regexp {^ Justification:} $txt d line]} {
  562.         $t tag add bugrpttok $idx.1 $idx.end
  563.         } elseif {[regexp {^ Work around:} $txt d line]} {
  564.         $t tag add bugrpttok $idx.1 $idx.end
  565.         } elseif {[regexp {^ Suggested fix:} $txt d line]} {
  566.         $t tag add bugrpttok $idx.1 $idx.end
  567.         } elseif {[regexp {^    Evaluation:} $txt d line]} {
  568.         $t tag add bugrpttok $idx.1 $idx.end
  569.         } elseif {[regexp {^ Interest list:} $txt d line]} {
  570.         $t tag add bugrpttok $idx.1 $idx.15
  571.         } elseif {[regexp {^ Comments:} $txt d line]} {
  572.         $t tag add bugrpttok $idx.1 $idx.end
  573.         } elseif {[regexp {^ See also:} $txt d line]} {
  574.         $t tag add bugrpttok $idx.1 $idx.10
  575.         } elseif {[regexp {^ Public Summary:} $txt d line]} {
  576.         $t tag add bugrpttok $idx.1 $idx.end
  577.         }
  578.     }
  579.     }
  580. }
  581.  
  582. proc MsgHighlightQuoteLevel { str } {
  583.     # <token> such as in SGML
  584.     if {[regexp {([^<]*)<(.+)>([^>]*)} $str d pre addr post]} {
  585.     return [MsgHighlightQuoteLevel $pre]
  586.     }
  587.     # a->b such as C pointer deference
  588.     if {[regexp {([a-zA-Z0-9_]+)->([a-zA-Z0-9_]+)} $str d pre post]} {
  589.     return [MsgHighlightQuoteLevel $pre]
  590.     }
  591.  
  592.     set qbits "\[ \t]*(\}|:|>|\\+>|\[A-Za-z0-9_-]+>)"
  593.     set best 0; set mexp ""; set bestmatch $str
  594.  
  595.     foreach {i} {1 2 3 4 5} {
  596.         append mexp $qbits
  597.         if {[regexp -- "^($mexp)" $str d substr]} {
  598.             set best $i 
  599.             set bestmatch $substr 
  600.         }
  601.     }
  602.     return [list $best $bestmatch]
  603. }
  604.